home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / print / pgraf130.zip / PASCAL.ZIP / DEMO_SUB.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-14  |  25KB  |  797 lines
  1. unit demo_sub;
  2.  
  3. {*******************************************************************
  4.  *                                                                  *
  5.  *  'Printer Graphics Interface' Demonstration Program              *
  6.  *  Demonstration Subrotuines Module                                *
  7.  *                                                                  *
  8.  *  Main program: DEMO.PAS                                                        *
  9.  *  Author: F van der Hulst                                         *
  10.  *                                                                  *
  11.  * Revisions:                                                       *
  12.  * 27 March   1991: Initial release (Turbo C v2.0 only)             *
  13.  * 07 April   1991: Ported to MicroSoft C v5.1                      *
  14.  * 15 October 1991: Rewritten in Turbo-Pascal                       *
  15.  *                                                                  *
  16.  *******************************************************************}
  17. interface
  18. uses graph, pgraph, dos, various;
  19.  
  20. procedure shapes_demo;
  21. procedure stroked_fonts_demo;
  22. procedure Default_Font_demo;
  23. procedure horiz_text_demo;
  24. procedure vert_text_demo;
  25. procedure text_scaling_demo;
  26. procedure shape_Fill_demo;
  27. procedure flood_Fill_demo;
  28. procedure lines_demo;
  29. procedure pie_demo;
  30.  
  31. procedure end_slice;
  32.  
  33. var page_height, page_width: integer;    { Size of page in pixels }
  34. var prn: file of char;                        { Output device }
  35. var screen_echo: boolean;
  36.  
  37. implementation
  38. const MAX_WIDTH = 801;        { Maximum width of any PGRAPH viewport defined in the program }
  39.  
  40. function min(x, y: integer): integer;
  41. begin
  42.     if (x < y)
  43.     then min := x
  44.     else min := y;
  45. end;
  46.  
  47. function max(x, y: integer): integer;
  48. begin
  49.     if (x > y)
  50.     then max := x
  51.     else max := y;
  52. end;
  53.  
  54. var line_num: integer;
  55. var FF: char;
  56.  
  57.  
  58. {*******************************************************************
  59.  End of outputting a slice to the buffer. Check to see whether it will
  60.  fit on the current page. If not skip to the top of the next page }
  61.  
  62. procedure end_slice;
  63. var
  64.     xres, yres: integer;
  65.     height: integer;
  66.  
  67. begin
  68.     p_getresolution(xres, yres);
  69.     xres := p_getmaxx;
  70.     height := p_getmaxy + 1;
  71.     line_num := line_num + height;
  72.     if (line_num > longint(yres) * page_height div 100) then begin
  73.         line_num := height;
  74.         write(prn, FF);
  75.     end;
  76.  
  77.     if not screen_echo then write('Printing...');
  78.     p_print(filerec(prn).handle);
  79.     if not screen_echo then writeln;
  80.     p_cleardevice;
  81. end;
  82.  
  83. {********************************************************************
  84.  Draw lines, ellipses, polygons, move graphics cursor }
  85.  
  86. procedure shapes_demo;
  87. var
  88.     xasp, yasp: integer;
  89.     xres, yres: integer;
  90.     error_code: integer;
  91.     width, height: integer;
  92.     free_space: longint;
  93.     arccoords: arccoordstype;
  94.  
  95. const polypoints: array[0..13] of integer = (
  96.     500, 160,
  97.     500, 340,
  98.     450, 250,
  99.     400, 250,
  100.     350, 330,
  101.     360, 170,
  102.     500, 160);
  103.  
  104. begin
  105.     writeln; writeln;
  106.     writeln('SHAPES DEMO');
  107.     writeln;
  108.     p_getresolution(xres, yres);
  109.     p_setviewport(0, 0, 0, 0, 0);
  110.     free_space := memavail - $4000;       { Leave room for other graph memory uses }
  111.     width := trunc((longint(xres) * longint(page_width)) / 100);
  112.     height := integer(free_space * 8 div width);
  113.     height := min(height, integer(longint(yres) * page_height div 100));
  114.     writeln('Setting ', width, ' by ', height, ' pixel (', width div xres,
  115.     '*', height div yres, ' inches) viewport');
  116.     p_setviewport(0, 0, width - 1, height - 1, 0);
  117.     error_code := p_graphresult;
  118.     if (error_code <> 0) or (height < 340) then writeln('Failed... Insufficient memory')
  119.     else begin
  120.         p_setlinestyle(4, $8080, 1);
  121.         p_rectangle(0, 0, p_getmaxx, p_getmaxy);
  122.         p_setlinestyle(2, 0, 1);
  123.         writeln('p_drawpoly(7, polypoints);');
  124.         p_drawpoly(7, polypoints);
  125.         writeln('p_rectangle(220, 140, 270, 10);');
  126.         p_rectangle(220, 240, 270, 110);
  127.         writeln('p_circle(p_getmaxx - 120, 100, 100);');
  128.         p_circle(p_getmaxx - 120, 100, 100);
  129.         writeln('p_arc(p_getmaxx - 220, 100, 45, 135, 100);');
  130.         p_arc(p_getmaxx - 220, 100, 45, 135, 100);
  131.         p_getarccoords(arccoords);
  132.         writeln('Last arc centred at (', arccoords.x, ', ', arccoords.y,
  133.             '), from (', arccoords.xstart, ', ', arccoords.ystart,
  134.             ') to (', arccoords.xend, ', ', arccoords.yend, ')');
  135.         writeln('p_ellipse(90, 10, 0, 360, 30, 10);');
  136.         p_ellipse(90, 10, 0, 360, 30, 10);
  137.         writeln('p_ellipse(160, 10, 0, 360, 5, 10);');
  138.         p_ellipse(160, 10, 0, 360, 5, 10);
  139.         writeln('p_ellipse(200, 10, 45, 135, 30, 10);');
  140.         p_ellipse(200, 10, 45, 135, 30, 10);
  141.         writeln('p_ellipse(240, 10, 45, 135, 5, 10);');
  142.         p_ellipse(240, 10, 45, 135, 5, 10);
  143.         writeln('p_ellipse(280, 10, 45, 225, 30, 10);');
  144.         p_ellipse(280, 10, 45, 225, 30, 10);
  145.         writeln('p_getaspectratio(xasp, yasp);');
  146.         writeln('p_setaspectratio(xasp, yasp div 3);');
  147.         p_getaspectratio(xasp, yasp);
  148.         p_setaspectratio(xasp, yasp div 3);
  149.         writeln('Same circle and arc as above, but Ycentre at 390');
  150.         p_circle(p_getmaxx - 120, 390, 100);
  151.         p_arc(p_getmaxx - 220, 390, 45, 135, 100);
  152.         writeln('Width = ', p_getmaxx, ', Height = ', p_getmaxy);
  153.         writeln('Current position = (', p_getx, ', ', p_gety, ')');
  154.         writeln('p_moveto(40, 50);');
  155.         p_moveto(40, 50);
  156.         writeln('Current position = (', p_getx, ', ', p_gety, ')');
  157.         writeln('p_moverel(+20, -10);');
  158.         p_moverel(+20, -10);
  159.         writeln('Current position = (', p_getx, ', ', p_gety, ')');
  160.  
  161.         writeln('Various ellipse fragments');
  162.         p_ellipse(450, 60,   0,  20, 100, 50);
  163.         p_ellipse(450, 60,  30,  60, 100, 50);
  164.         p_ellipse(450, 60,  70,  90, 100, 50);
  165.         p_ellipse(450, 60,  90, 110, 100, 50);
  166.         p_ellipse(450, 60, 120, 150, 100, 50);
  167.         p_ellipse(450, 60, 160, 180, 100, 50);
  168.         p_ellipse(450, 60, 180, 200, 100, 50);
  169.         p_ellipse(450, 60, 210, 240, 100, 50);
  170.         p_ellipse(450, 60, 250, 270, 100, 50);
  171.         p_ellipse(450, 60, 270, 290, 100, 50);
  172.         p_ellipse(450, 60, 300, 330, 100, 50);
  173.         p_ellipse(450, 60, 340, 360, 100, 50);
  174.         p_ellipse(100, 140, 20, 340, 100, 50);
  175.  
  176.         writeln('Lines');
  177.         p_setlinestyle(3, 0, 1);
  178.         p_line(100, 140, 200, 140);
  179.         p_line(100, 140, 100, 90);
  180.         p_line(0, 200, 10, 250);
  181.         p_line(0, 200, 50, 210);
  182.         p_line(50, 210, 0, 220);
  183.         p_line(50, 210, 40, 250);
  184.         p_moveto(450, 60);
  185.         p_linerel(100, 0);
  186.         p_lineto(450, 110);
  187.  
  188.         writeln('Pixels');
  189.         p_putpixel(319, 0, 1);
  190.         p_putpixel(319, 1, 1);
  191.         p_putpixel(319, 1, 0);
  192.         end_slice;
  193.     end;
  194. end;
  195.  
  196. {*******************************************************************
  197.  Register stroked fonts, and print them in different sizes and
  198.  orientations }
  199.  
  200. procedure stroked_fonts_demo;
  201. var goth_height, next_line: integer;
  202. var errorcode: integer;
  203.  
  204. begin
  205.     writeln; writeln;
  206.     writeln('STROKED FONTS DEMO');
  207.     writeln;
  208.     p_setviewport(0, 0, 719, 170, 0);
  209.     errorcode := p_registerbgifont(@Gothic_Font);
  210.     if errorcode < 0 then begin
  211.         writeln('Couldn''t register Gothic font: ', errorcode);
  212.         halt(2);
  213.     end;
  214.     errorcode := p_registerfarbgifont(@Script_Font_far);
  215.     if errorcode < 0 then begin
  216.         writeln('Couldn''t register Script font: ', errorcode);
  217.         halt(2);
  218.     end;
  219.     writeln('Printing text size 1, horizontally');
  220.     p_settextstyle(GothicFont, HorizDir, 1);
  221.     p_outtextxy(0, 0, 'Gothic 1');
  222.     goth_height := p_textheight('Gothic 1');
  223.     p_settextstyle(ScriptFont, HorizDir, 1);
  224.     p_outtextxy(200, 0, 'Script 1');
  225.     next_line := max(p_textheight('Script 1'), goth_height);
  226.  
  227.     writeln('Printing text size 1, vertically');
  228.     p_settextstyle(GothicFont, VertDir, 1);
  229.     p_outtextxy(360, 0, 'Gothic 1');
  230.     p_settextstyle(ScriptFont, VertDir, 1);
  231.     p_outtextxy(380, 0, 'Script 1');
  232.  
  233.     writeln('Printing text size 2, horizontally');
  234.     p_settextstyle(GothicFont, HorizDir, 2);
  235.     p_outtextxy(0, next_line, 'Gothic 2');
  236.     goth_height := p_textheight('Gothic 2');
  237.     p_settextstyle(ScriptFont, HorizDir, 2);
  238.     p_outtextxy(200, next_line, 'Script 2');
  239.     next_line := next_line + max(p_textheight('Script 2'), goth_height);
  240.  
  241.     writeln('Printing text size 2, vertically');
  242.     p_settextstyle(GothicFont, VertDir, 2);
  243.     p_outtextxy(410, 0, 'Gothic 2');
  244.     p_settextstyle(ScriptFont, VertDir, 2);
  245.     p_outtextxy(430, 0, 'Script 2');
  246.  
  247.     writeln('Printing text size 3, horizont